;; time/time.scm - (c) rohan drape, 2000-2005

;; Translate the SRFI-19 time object `time' into an SFRI-19 date
;; object.  This procedure simply determines the type of `time' and calls
;; the appropriate translator.

(define (time->date time)
  (let ((type (time-type time)))
    (case type
      ((time-utc) (time-utc->date time))
      ((time-tai) (time-tai->date time))
      ((time-monotonic) (time-monotonic->date time))
      (else (error "time->date: illegal time type" type)))))

;; Evaluates to a string in the ISO-8601 format for the SFRI-19 time
;; or SFRI-19 date object `time-or-date'.

(define (iso-8601-string time-or-date)
  (date->string 
   (if (time? time-or-date)
       (time->date time-or-date)
       time-or-date) 
   "~5"))

;; Evaluates to a duple {time result}, the time being the number of
;; seconds that elapsed during the evaluation of the no-argument
;; function `f', and the result being the result of the evaluation.
;; `gettime' is the thunk to get the current time as a real number.

(define (timeP gettime f)
  (let* ((start-time (gettime))
	 (result (f))
	 (end-time (gettime)))
    (list (- end-time start-time) result)))

;; Syntax to time a set of expressions.

(define-syntax timeE
  (syntax-rules ()
    ((_ expr ...) (timeP utc (lambda () expr ...)))))

;; Evaluates to a <real> number representing the number of seconds at
;; the SRFI-19 time object `time'.

(define (time->real time)
  (+ (time-second time)
     (/ (time-nanosecond time) 1000000000.0)))

;; Evaluates to an SRFI-19 time object in UTC form representing the
;; number of seconds at the real number `n'.

(define (real->time n)
  (let* ((seconds (floorE n))
	 (nanoseconds (floorE (* (- n seconds) 1000000000))))
    (make-time time-utc nanoseconds seconds)))

;; Evaluates to an SRFI-19 time object in DURATION form representing
;; the number of seconds at the real number `n'.

(define (real->time-duration n)
  (let* ((seconds (floorE n))
	 (nanoseconds (floorE (* (- n seconds) 1000000000))))
    (make-time time-duration nanoseconds seconds)))

;; Evaluate to a duple giving the time interval `t' in minutes and
;; seconds, accurate to the nearest second.  Both values are exact
;; integers regardless of `t'.

(define (time-interval->minutes+seconds t)
  (let* ((seconds (modulo (roundE t) 60))
	 (minutes (floorE (/ t 60))))
    (list minutes seconds)))

;; Inverse of above.

(define (minutes+seconds->time-interval t)
  (+ (* (car t) 60) (cadr t)))

;; Addition of times.

(define (minutes+seconds-sum . t)
  (time-interval->minutes+seconds
   (fold + 0 (map minutes+seconds->time-interval t))))
